PsL Monthly 1993 December/PSL Monthly Shareware CD-ROM (December 1993).iso/prgmming/dos/pascal/lzrtpu.com/LASERPRT.PAS

Pascal/Delphi Source File | 1990-10-19 | 24.9 KB | 735 lines

Unit LaserPrt;

{++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Unit for formating program printouts to be printed on an HP LaserJet
or compatible printer.

Prepared by Bob Smedley (Compuserv PPN 72331,3615)

Copyright, 1990 - D. Robert Smedley
This Turbo Pascal unit is made available at no cost for non-commercial
use only.

The author makes no claim as to the unit's suitability for any specific
use and expressly disavows any responsibility for real or consequential
damages of any sort.
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

Interface

Type
  PrinterUnits = (columns, decipoints, dots, rows);

Function trimspaces(s:string):string;
{this function removes both leading and trailing blanks in a string}

Function intostring(i:longint):string;
{this function converts a longint type number into a string with all
 blanks removed}

Function realtostring(r:real;places:integer):string;
{this function converts a real type number into a string with all
 blanks removed}

Function ResetLaser:String;
{this function resets the printer}

Function Legal:string;
{this function calls for the legal page size}

Function Letter:string;
{this function calls for the letter page size}

Function Pagelength(J:Integer):string;
{this function selects the logical page length in lines}

Function Portrait:String;
{this function designates a portrait printout}

Function Landscape:String;
{this function designates a landscape printout}

Function LeftMargin(J:Integer):String;
{this function sets the left margin to the specified column}

Function RightMargin(J:Integer):String;
{this function sets the right margin to the specified column}

Function ClearMargins:String;
{this function clears both left and right margins}

Function TopMargin(J:Integer):String;
{this function sets the number of lines between the top of the logical
page and the top of the text}

Function Linesperinch(J:Integer):String;
{this function sets the number of lines per inch.  Only 1, 2, 3, 4, 6,
8, 12, 16, 24, and 48 lpi are supported.  Numbers between these are
rounded based on the following case structure:
                     1: J:=1;
                     2: J:=2;
                     3: J:=3;
                     4: J:=4;
                  5..6: J:=6;
                 7..10: J:=8;
                11..13: J:=12;
                14..20: J:=16;
                21..36: J:=24;
                37..99: J:=48;}

Function VMI(X:real):string;
{this function designates the distance between lines - an alternate way
to set lines per inch.  The X parameter is equal to the number of 1/48th
of an inch that the vertical motion index is to be set. It is valid to
four decimal places}

Function AbsoluteX(X:Real;PrtUnits:PrinterUnits):String;
{this function moves the cursor to a specific dimension from the left
edge of the logical page.  The move can be given either in terms of the
column number, decipoints (a decipoint is 1/720th inch), or dots (a dot
is 1/300th inch).

When columns are used, the X parameter is the column number from the
left edge of the logical page for the new location of the cursor and the
PrtUnits parameter is "Columns" (without the quotes).  The column number
is valid to 4 decimal places.

When decipoints are used, the X parameter is the number of decipoints
from the left edge of the logical page for the new location of the
cursor and the PrtUnits parameter is "Decipoints" (without the quotes).
  The decipoint value is valid to 2 decimal places.

When dots are used, the X parameter is the number of dots from the left
edge of the logical page for the new location of the cursor and the
PrtUnits parameter is "Dots" (without the quotes).  The dot value is
valid to 0 (zero) decimal places (i.e. only integer numbers are valid
but must be provided as real).}

Function AbsoluteY(Y:Real;PrtUnits:PrinterUnits):String;
{this function moves the cursor to a specific dimension from the top
margin.  The move can be given either in terms of the row number,
decipoints (a decipoint is 1/720th inch), or dots (a dot is 1/300th inch).

When rows are used, the Y parameter is the row number from the top
margin for the new location of the cursor and the PrtUnits parameter is
"Rows" (without the quotes).  The row number is valid to 4 decimal
places.

When decipoints are used, the Y parameter is the number of decipoints
from the top margin for the new location of the cursor and the PrtUnits
parameter is "Decipoints" (without the quotes).  The decipoint value is
valid to 2 decimal places.

When dots are used, the Y parameter is the number of dots from the top
margin for the new location of the cursor and the PrtUnits parameter is
"Dots" (without the quotes).  The dot value is valid to 0 (zero) decimal
places (i.e. only integer numbers are valid but must be provided as
real).}

Function RightX(X:real;PrtUnits:PrinterUnits):string;
{this function moves the cursor a specific distance to the right from
the current location of the cursor.  The move can be given either in
terms of number of columns, decipoints (a decipoint is 1/720th inch), or
dots (a dot is 1/300th inch).

When columns are used, the X parameter is the number of columns to move
from the current position of the cursor and the PrtUnits parameter is
"Columns" (without the quotes).  The number of columns number is valid
to 4 decimal places.

When decipoints are used, the X parameter is the number of decipoints
to move from the current position of the cursor and the PrtUnits
parameter is "Decipoints" (without the quotes).  The decipoint value is
valid to 2 decimal places.

When dots are used, the X parameter is the number of dots to move from
the current position of the cursor and the PrtUnits parameter is "Dots"
(without the quotes).  The dot value is valid to 0 (zero) decimal places
(i.e. only integer numbers are valid but must be provided as real).}

Function LeftX(X:real;PrtUnits:PrinterUnits):string;
{this function moves the cursor a specific distance to the left from
the current location of the cursor.  The move can be given either in
terms of number of columns, decipoints (a decipoint is 1/720th inch), or
dots (a dot is 1/300th inch).

When columns are used, the X parameter is the number of columns to move
from the current position of the cursor and the PrtUnits parameter is
"Columns" (without the quotes).  The number of columns number is valid
to 4 decimal places.

When decipoints are used, the X parameter is the number of decipoints
to move from the current position of the cursor and the PrtUnits
parameter is "Decipoints" (without the quotes).  The decipoint value is
valid to 2 decimal places.

When dots are used, the X parameter is the number of dots to move from
the current position of the cursor and the PrtUnits parameter is "Dots"
(without the quotes).  The dot value is valid to 0 (zero) decimal places
(i.e. only integer numbers are valid but must be provided as real).}

Function UpY(Y:real;PrtUnits:PrinterUnits):string;
{this function moves the cursor a specific distance up from the current
position of the cursor.  The move can be given either in terms of the
number of rows, decipoints (a decipoint is 1/720th inch), or dots (a dot
is 1/300th inch).

When rows are used, the Y parameter is the number of rows to move the
cursor from the current location of the cursor and the PrtUnits
parameter is "Rows" (without the quotes).  The row number is valid to 4
decimal places.

When decipoints are used, the Y parameter is the number of decipoints
to move the cursor from the current location of the cursor and the
PrtUnits parameter is "Decipoints" (without the quotes).  The decipoint
value is valid to 2 decimal places.

When dots are used, the Y parameter is the number of dots to move the
cursor from the current location of the cursor and the PrtUnits
parameter is "Dots" (without the quotes).  The dot value is valid to 0
(zero) decimal places (i.e. only integer numbers are valid but must be
provided as real).}

Function DownY(Y:real;PrtUnits:PrinterUnits):string;
{this function moves the cursor a specific distance down from the
current position of the cursor.  The move can be given either in terms
of the number of rows, decipoints (a decipoint is 1/720th inch), or dots
(a dot is 1/300th inch).

When rows are used, the Y parameter is the number of rows to move the
cursor from the current location of the cursor and the PrtUnits
parameter is "Rows" (without the quotes).  The row number is valid to 4
decimal places.

When decipoints are used, the Y parameter is the number of decipoints
to move the cursor from the current location of the cursor and the
PrtUnits parameter is "Decipoints" (without the quotes).  The decipoint
value is valid to 2 decimal places.

When dots are used, the Y parameter is the number of dots to move the
cursor from the current location of the cursor and the PrtUnits
parameter is "Dots" (without the quotes).  The dot value is valid to 0
(zero) decimal places (i.e. only integer numbers are valid but must be
provided as real).}

Function HalfLine:String;
{this function moves the cursor to the same character position one half
line down.  The distance moved depends on the lines per inch value}

Function LineFeed:String;
{this function moves the cursor to the same character position one line
down.  The distance moved depends on the lines per inch value}

Function FormFeed:String;
{this function issues a form feed}

Function PushXY:String;
{this function allows the cursor position to be stored and recalled for
later use.  Up to 20 positions may be pushed}

Function PopXY:String;
{this function recalls the last "pop'ed" cursor location}

Function SymbolSet(Sym:String):String;
{this function designates the primary set of symbols or characters
contained in a font.  Refer to your printer manual for the available
symbol sets.  Some of the moct common are:
              8M - HP Math-8
              8U - HP Roman-8
             10U - PC-8 (USA)
              0N - ECMA-94 Latin 1}

Function Proportional:String;
{this function designates a proportional spaced font}

Function Fixed:String;
{this function designates a fixed spaced font}

Function Pitch(X:real):String;
{this function designated the horizontal spacing of a fixed spaced font
in terms of the number of characters per inch.}

Function Points(X:real):String;
{this function designates the height of the font in points.}

Function Upright:String;
{this function selects an upright font style}

Function Italic:String;
{this function selects an italic font style}

Function Bold:String;
{this function selects a bold stroke weight}

Function Normal:String;
{this function selects a normal (medium) stroke weight}

Function UltraBlack:String;
{this function selects an ultra black stroke weight}

Function UltraThin:String;
{this function selects an ultra thin stroke weight}

Function LinePrinter:String;
{this function selects the Lineprinter font}

Function Pica:String;
{this function selects the Pica font}

Function Elite:String;
{this function selects the Elite font}

Function Courier:String;
{this function selects the Courier font}

Function Helv:String;
{this function selects the Helvetica font}

Function TimesRoman:String;
{this function selects the Times Roman font}

Function Gothic:String;
{this function selects the Gothic font}

Function Script:String;
{this function selects the Script font}

Function Prestige:String;
{this function selects the Prestige font}

Function UnderlineOn:String;
{this function turns on the fixed undeline}

Function UnderlineOff:String;
{this function turns off the undeline}

Function shadewidth(X:real):string;
{this function specifies the rectangular fill area width in decipoints.}

Function shadeheight(X:real):string;
{this function specifies the rectangular fill area height in
decipoints.}

Function shadepercent(J:Integer):string;
{this function sets the level of shading to be used.  The J parameter is
in terms of percent shading.}

Function printshade:string;
{this function causes the defined rectangular area to be filled with the
specified shading}

Implementation
{---------------------------------------------------------------------}
Function trimspaces(s:string):string;

Begin
  while (s[1]= ' ') do
    delete(s,1,1);
  while (s[length(s)]= ' ') do dec(s[0]);
  trimspaces:=s;
end;
{---------------------------------------------------------------------}
{---------------------------------------------------------------------}
Function intostring(i:longint):string;

var
s:string;

begin
  str(i:12,s);
  intostring:=trimspaces(s);
end;
{---------------------------------------------------------------------}
{---------------------------------------------------------------------}
Function realtostring(r:real;places:integer):string;

var
s:string;

begin
  str(r:15:places,s);
  realtostring:=trimspaces(s);
end;
{---------------------------------------------------------------------}
{---------------------------------------------------------------------}
Function ResetLaser:String;

Begin
ResetLaser:=chr(27)+'E';
end;
{---------------------------------------------------------------------}
{---------------------------------------------------------------------}
Function Legal:string;

begin
legal:=chr(27)+'&l3A';
end;
{---------------------------------------------------------------------}
{---------------------------------------------------------------------}
Function Letter:string;

begin
letter:=chr(27)+'&l2A';
end;
{---------------------------------------------------------------------}
{---------------------------------------------------------------------}
Function Pagelength(J:Integer):string;

begin
Pagelength:=chr(27)+'&l'+intostring(J)+'P';
end;
{---------------------------------------------------------------------}
{---------------------------------------------------------------------}
Function Portrait:String;

Begin
Portrait:=chr(27)+'&l0O';
End;
{--------------------------------------------------------------------}
{--------------------------------------------------------------------}
Function Landscape:String;

Begin
Landscape:=chr(27)+'&l1O';
End;
{--------------------------------------------------------------------}
{--------------------------------------------------------------------}
Function LeftMargin(J:Integer):String;

Begin
leftmargin:=chr(27)+'&a'+intostring(J)+'L';
End;
{--------------------------------------------------------------------}
{--------------------------------------------------------------------}
Function RightMargin(J:Integer):String;

Begin
rightmargin:=chr(27)+'&a'+intostring(J)+'M';
End;
{--------------------------------------------------------------------}
{--------------------------------------------------------------------}
Function ClearMargins:String;

Begin
clearmargins:=chr(27)+'9';
End;
{--------------------------------------------------------------------}
{--------------------------------------------------------------------}
Function TopMargin(J:Integer):String;

Begin
Topmargin:=chr(27)+'&l'+intostring(J)+'E';
End;
{--------------------------------------------------------------------}
{--------------------------------------------------------------------}
Function Linesperinch(J:Integer):String;

Begin
case J of
      1: J:=1;
      2: J:=2;
      3: J:=3;
      4: J:=4;
   5..6: J:=6;
  7..10: J:=8;
 11..13: J:=12;
 14..20: J:=16;
 21..36: J:=24;
 37..99: J:=48;
  end;
linesperinch:=chr(27)+'&l'+intostring(J)+'D';
End;
{--------------------------------------------------------------------}
{--------------------------------------------------------------------}
Function VMI(X:real):String;

begin
  vmi:=chr(27)+'&l'+realtostring(x,4)+'C';
End;
{--------------------------------------------------------------------}
{--------------------------------------------------------------------}
Function AbsoluteX(X:real;PrtUnits:PrinterUnits):String;

Begin
case PrtUnits of
 columns    : AbsoluteX:=chr(27)+'&a'+realtostring(x,4)+'C';
 Decipoints : AbsoluteX:=chr(27)+'&a'+realtostring(x,2)+'H';
 Dots       : AbsoluteX:=chr(27)+'*p'+realtostring(x,0)+'X';
 end;
End;
{--------------------------------------------------------------------}
{--------------------------------------------------------------------}
Function AbsoluteY(Y:real;PrtUnits:PrinterUnits):String;

Begin
case PrtUnits of
 rows       : AbsoluteY:=chr(27)+'&a'+realtostring(Y,4)+'R';
 Decipoints : AbsoluteY:=chr(27)+'&a'+realtostring(Y,2)+'V';
 Dots       : AbsoluteY:=chr(27)+'*p'+realtostring(Y,0)+'Y';
 end;
End;
{--------------------------------------------------------------------}
{---------------------------------------------------------------------}
Function RightX(X:real;PrtUnits:PrinterUnits):string;

Begin
case PrtUnits of
 columns    : RightX:=chr(27)+'&a+'+realtostring(x,4)+'C';
 Decipoints : RightX:=chr(27)+'&a+'+realtostring(x,2)+'H';
 Dots       : RightX:=chr(27)+'*p+'+realtostring(x,0)+'X';
 end;
End;
{---------------------------------------------------------------------}
{---------------------------------------------------------------------}
Function LeftX(X:real;PrtUnits:PrinterUnits):string;

Begin
case PrtUnits of
 columns    : LeftX:=chr(27)+'&a-'+realtostring(x,4)+'C';
 Decipoints : LeftX:=chr(27)+'&a-'+realtostring(x,2)+'H';
 Dots       : LeftX:=chr(27)+'*p-'+realtostring(x,0)+'X';
 end;
End;
{---------------------------------------------------------------------}
{---------------------------------------------------------------------}
Function UpY(Y:real;PrtUnits:PrinterUnits):string;

Begin
case PrtUnits of
 rows       : UpY:=chr(27)+'&a-'+realtostring(Y,4)+'R';
 Decipoints : UpY:=chr(27)+'&a-'+realtostring(Y,2)+'V';
 Dots       : UpY:=chr(27)+'*p-'+realtostring(Y,0)+'Y';
 end;
End;
{---------------------------------------------------------------------}
{---------------------------------------------------------------------}
Function DownY(Y:real;PrtUnits:PrinterUnits):string;

Begin
case PrtUnits of
 rows       : DownY:=chr(27)+'&a+'+realtostring(Y,4)+'R';
 Decipoints : DownY:=chr(27)+'&a+'+realtostring(Y,2)+'V';
 Dots       : DownY:=chr(27)+'*p+'+realtostring(Y,0)+'Y';
 end;
End;
{---------------------------------------------------------------------}
{--------------------------------------------------------------------}
Function HalfLine:String;

Begin
halfline:=chr(27)+'=';
End;
{--------------------------------------------------------------------}
{--------------------------------------------------------------------}
Function LineFeed:String;

Begin
linefeed:=chr(10);
End;
{--------------------------------------------------------------------}
{--------------------------------------------------------------------}
Function FormFeed:String;

Begin
Formfeed:=chr(12);
End;
{--------------------------------------------------------------------}
{--------------------------------------------------------------------}
Function PushXY:String;

Begin
PushXY:=chr(27)+'&f0S';
End;
{--------------------------------------------------------------------}
{--------------------------------------------------------------------}
Function PopXY:String;

Begin
PopXY:=chr(27)+'&f1S';
End;
{--------------------------------------------------------------------}
{--------------------------------------------------------------------}
Function SymbolSet(Sym:String):String;

Begin
SymbolSet:=chr(27)+'('+Sym;
End;
{--------------------------------------------------------------------}
{--------------------------------------------------------------------}
Function Proportional:String;

Begin
Proportional:=chr(27)+'(s1P';
End;
{--------------------------------------------------------------------}
{--------------------------------------------------------------------}
Function Fixed:String;

Begin
Fixed:=chr(27)+'(s0P';
End;
{--------------------------------------------------------------------}
{--------------------------------------------------------------------}
Function Pitch(X:real):String;

Begin
pitch:=chr(27)+'(s'+realtostring(x,2)+'H';
End;
{--------------------------------------------------------------------}
{--------------------------------------------------------------------}
Function Points(X:real):String;

Begin
points:=chr(27)+'(s'+realtostring(x,2)+'V';
End;
{--------------------------------------------------------------------}
{--------------------------------------------------------------------}
Function Upright:String;

Begin
Upright:=chr(27)+'(s0S';
End;
{--------------------------------------------------------------------}
{--------------------------------------------------------------------}
Function Italic:String;

Begin
Italic:=chr(27)+'(s1S';
End;
{--------------------------------------------------------------------}
{--------------------------------------------------------------------}
Function Bold:String;

Begin
Bold:=chr(27)+'(s3B';
End;
{--------------------------------------------------------------------}
{--------------------------------------------------------------------}
Function Normal:String;

Begin
Normal:=chr(27)+'(s0B';
End;
{--------------------------------------------------------------------}
{--------------------------------------------------------------------}
Function UltraBlack:String;

Begin
UltraBlack:=chr(27)+'(s7B';
End;
{--------------------------------------------------------------------}
{--------------------------------------------------------------------}
Function UltraThin:String;

Begin
UltraThin:=chr(27)+'(s-7B';
End;
{--------------------------------------------------------------------}
{--------------------------------------------------------------------}
Function LinePrinter:String;

Begin
Lineprinter:=chr(27)+'(s0T';
End;
{--------------------------------------------------------------------}
{--------------------------------------------------------------------}
Function Pica:String;

Begin
Pica:=chr(27)+'(s1T';
End;
{--------------------------------------------------------------------}
{--------------------------------------------------------------------}
Function Elite:String;

Begin
Elite:=chr(27)+'(s2T';
End;
{--------------------------------------------------------------------}
{--------------------------------------------------------------------}
Function Courier:String;

Begin
Courier:=chr(27)+'(s3T';
End;
{--------------------------------------------------------------------}
{--------------------------------------------------------------------}
Function Helv:String;

Begin
Helv:=chr(27)+'(s4T';
End;
{--------------------------------------------------------------------}
{--------------------------------------------------------------------}
Function TimesRoman:String;

Begin
TimesRoman:=chr(27)+'(s5T';
End;
{--------------------------------------------------------------------}
{--------------------------------------------------------------------}
Function Gothic:String;

Begin
Gothic:=chr(27)+'(s6T';
End;
{--------------------------------------------------------------------}
{--------------------------------------------------------------------}
Function Script:String;

Begin
Script:=chr(27)+'(s7T';
End;
{--------------------------------------------------------------------}
{--------------------------------------------------------------------}
Function Prestige:String;

Begin
Prestige:=chr(27)+'(s8T';
End;
{--------------------------------------------------------------------}
{--------------------------------------------------------------------}
Function UnderlineOn:String;

Begin
UnderlineOn:=chr(27)+'&d0D';
End;
{--------------------------------------------------------------------}
{--------------------------------------------------------------------}
Function UnderlineOff:String;

Begin
UnderlineOff:=chr(27)+'&d@';
end;
{---------------------------------------------------------------------}
{---------------------------------------------------------------------}
Function shadewidth(X:real):string;

Begin
shadewidth:=chr(27)+'*c'+realtostring(x,2)+'H';
end;
{---------------------------------------------------------------------}
{---------------------------------------------------------------------}
Function shadeheight(X:real):string;

Begin
shadeheight:=chr(27)+'*c'+realtostring(x,2)+'V';
end;
{---------------------------------------------------------------------}
{---------------------------------------------------------------------}
Function shadepercent(J:Integer):string;

Begin
shadepercent:=chr(27)+'*c'+intostring(J)+'G';
end;
{---------------------------------------------------------------------}
{---------------------------------------------------------------------}
Function printshade:string;

Begin
printshade:=chr(27)+'*c2P';
end;
{---------------------------------------------------------------------}
end.